Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH2/SRC/MMETA.FRM

Text File | 1996-04-18 | 6KB | 222 lines

VERSION 4.00
Begin VB.Form MMetaForm
   AutoRedraw      =   -1  'True
   Caption         =   "Memory Metafile"
   ClientHeight    =   3660
   ClientLeft      =   2100
   ClientTop       =   1845
   ClientWidth     =   5580
   Height          =   4350
   Left            =   2040
   LinkTopic       =   "Form1"
   ScaleHeight     =   3660
   ScaleWidth      =   5580
   Top             =   1215
   Width           =   5700
   Begin VB.CommandButton CmdClear
      Caption         =   "Clear"
      Height          =   495
      Left            =   960
      TabIndex        =   6
      Top             =   2880
      Width           =   735
   End
   Begin VB.CommandButton CmdCopy
      Caption         =   "Copy"
      Height          =   495
      Left            =   120
      TabIndex        =   5
      Top             =   2880
      Width           =   735
   End
   Begin VB.PictureBox Dest
      AutoRedraw      =   -1  'True
      Height          =   1815
      Index           =   3
      Left            =   3760
      ScaleHeight     =   117
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   117
      TabIndex        =   4
      Top             =   1840
      Width           =   1815
   End
   Begin VB.PictureBox Dest
      AutoRedraw      =   -1  'True
      Height          =   1815
      Index           =   2
      Left            =   1920
      ScaleHeight     =   117
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   117
      TabIndex        =   3
      Top             =   1840
      Width           =   1815
   End
   Begin VB.PictureBox Dest
      AutoRedraw      =   -1  'True
      Height          =   1815
      Index           =   1
      Left            =   3760
      ScaleHeight     =   117
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   117
      TabIndex        =   2
      Top             =   0
      Width           =   1815
   End
   Begin VB.PictureBox Dest
      AutoRedraw      =   -1  'True
      Height          =   1815
      Index           =   0
      Left            =   1920
      ScaleHeight     =   117
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   117
      TabIndex        =   1
      Top             =   0
      Width           =   1815
   End
   Begin VB.PictureBox Source
      AutoRedraw      =   -1  'True
      Height          =   1815
      Left            =   0
      ScaleHeight     =   117
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   117
      TabIndex        =   0
      Top             =   960
      Width           =   1815
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
End
Attribute VB_Name = "MMetaForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Dim Drawing As Boolean
Dim PointX() As Single
Dim PointY() As Single
Dim NumPoints As Integer
Dim LastPoint As Integer
Dim LastX As Single
Dim LastY As Single



Private Sub CmdClear_Click()
    Source.Cls
    LastPoint = 0
End Sub

Private Sub Source_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Drawing = True
    LastX = x
    LastY = y
    AddPoint -x, y
End Sub
' ***********************************************
' Add a point to the list of points.
' ***********************************************
Sub AddPoint(x As Single, y As Single)
    LastPoint = LastPoint + 1
    If LastPoint > NumPoints Then
        NumPoints = NumPoints + 100
        ReDim Preserve PointX(1 To NumPoints)
        ReDim Preserve PointY(1 To NumPoints)
    End If
    PointX(LastPoint) = x
    PointY(LastPoint) = y

    If x < 0 Then
        Source.CurrentX = -x
        Source.CurrentY = y
    Else
        Source.Line -(x, y)
    End If
End Sub

Private Sub Source_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not Drawing Then Exit Sub

    AddPoint x, y
End Sub

Private Sub Source_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Not Drawing Then Exit Sub
    Drawing = False

    AddPoint x, y
End Sub

Private Sub mnuFileExit_Click()
    Unload Me
End Sub

' ***********************************************
' Create a memory metafile and play it back into
' the destination picture boxes.
' ***********************************************
Private Sub CmdCopy_Click()
Dim i As Integer
Dim mhdc As Integer
Dim hMF As Integer
Dim status As Long
Dim x As Single
Dim y As Single

    ' Create the memory metafile.
    mhdc = CreateMetaFile(ByVal 0&)
    If mhdc = 0 Then
        Beep
        MsgBox "Error creating metafile.", vbExclamation
        Exit Sub
    End If

    ' Draw in the metafile.
    For i = 1 To LastPoint
        x = PointX(i)
        y = PointY(i)
        If x < 0 Then
#If Win32 Then
            status = MoveToEx(mhdc, -x, y, ByVal 0&)
#Else
            status = MoveTo(mhdc, -x, y)
#End If
        Else
            status = LineTo(mhdc, x, y)
        End If
    Next i

    ' Close the metafile.
    hMF = CloseMetaFile(mhdc)
    If hMF = 0 Then
        Beep
        MsgBox "Error closing metafile.", vbExclamation
    Else
        ' Play the metafile.
        For i = 0 To 3
            Dest(i).Cls
            If PlayMetaFile(Dest(i).hdc, hMF) = 0 Then
                Beep
                MsgBox "Error playing metafile.", vbExclamation
                Exit For
            End If
            Dest(i).Refresh
        Next i
    End If

    ' Delete the metafile.
    If DeleteMetaFile(hMF) = 0 Then
        Beep
        MsgBox "Error deleting metafile.", vbExclamation
    End If
End Sub